Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/actassst/mdinote.ba_/mdinote.ba

Text File | 1998-02-25 | 8.9 KB | 259 lines

Attribute VB_Name = "Module1"
'*** Global module for MDI Notepad sample application.  ***
'**********************************************************
Option Explicit

' User-defined type to store information about child forms
Type FormState
    Deleted As Integer
    Dirty As Integer
    Color As Long
End Type

Public FState()  As FormState           ' Array of user-defined types
Public Document() As New frmNotePad     ' Array of child form objects
Public gFindString As String            ' Holds the search text.
Public gFindCase As Integer             ' Key for case sensitive search
Public gFindDirection As Integer        ' Key for search direction.
Public gCurPos As Integer               ' Holds the cursor location.
Public gFirstTime As Integer            ' Key for start position.
Public gToolsHidden As Boolean          ' Holds toolbar state.
Public Const ThisApp = "MDINote"        ' Registry App constant.
Public Const ThisKey = "Recent Files"   ' Registry Key constant.
Public strSearch As String              ' Holds the return string from the assistant.


Function AnyPadsLeft() As Integer
    Dim i As Integer        ' Counter variable

    ' Cycle through the document array.
    ' Return true if there is at least one open document.
    For i = 1 To UBound(Document)
        If Not FState(i).Deleted Then
            AnyPadsLeft = True
            Exit Function
        End If
    Next
End Function


Sub EditCopyProc()
    ' Copy the selected text onto the Clipboard.
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
End Sub

Sub EditCutProc()
    ' Copy the selected text onto the Clipboard.
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
    ' Delete the selected text.
    frmMDI.ActiveForm.ActiveControl.SelText = ""
End Sub

Sub EditPasteProc()
    ' Place the text from the Clipboard into the active control.
    frmMDI.ActiveForm.ActiveControl.SelText = Clipboard.GetText()
End Sub
Sub Assistant()
    Dim MyAssistant As Assistant

    Set MyAssistant = frmMDI.Assistant1
    ' Display Assistant if not already visible.
    If MyAssistant.AssistantVisible = False Then
        MyAssistant.Reduced = True
        ''MyAssistant.Visible = True
        MyAssistant.AssistantShow
    End If

'    ' Play Assistant Animantion at random intervals if Assistant is visible
'    Interval = Int((5 * Rnd) + 1)    ' Generate random value between 1 and 5 Mins.
'    Interval = Interval * 100

'    ' Set Timer Interval
'    frmMDI.Timer1.Interval = Interval
'    frmMDI.Timer1.Enabled = Not frmMDI.Timer1.Enabled
'    If Not frmMDI.Timer1.Enabled Then MyAssistant.StopAnimation

    Set MyAssistant = Nothing
    ' Set focus back to the toolbar form.
    frmMDI.SetFocus
End Sub
Sub FileNew()
    Dim fIndex As Integer

    ' Find the next available index and show the child form.
    fIndex = FindFreeIndex()
    Document(fIndex).Tag = fIndex
    Document(fIndex).Caption = "Untitled:" & fIndex
    Document(fIndex).Show

    ' Make sure the toolbar edit buttons are visible.
    frmMDI.imgCutButton.Visible = True
    frmMDI.imgCopyButton.Visible = True
    frmMDI.imgPasteButton.Visible = True
End Sub

Function FindFreeIndex() As Integer
    Dim i As Integer
    Dim ArrayCount As Integer

    ArrayCount = UBound(Document)

    ' Cycle through the document array. If one of the
    ' documents has been deleted, then return that index.
    For i = 1 To ArrayCount
        If FState(i).Deleted Then
            FindFreeIndex = i
            FState(i).Deleted = False
            Exit Function
        End If
    Next

    ' If none of the elements in the document array have
    ' been deleted, then increment the document and the
    ' state arrays by one and return the index to the
    ' new element.
    ReDim Preserve Document(ArrayCount + 1)
    ReDim Preserve FState(ArrayCount + 1)
    FindFreeIndex = UBound(Document)
End Function

Sub FindIt()
    Dim intStart As Integer
    Dim intPos As Integer
    Dim strFindString As String
    Dim strSourceString As String
    Dim strMsg As String
    Dim intResponse As Integer
    Dim intOffset As Integer

    ' Set offset variable based on cursor position.
    If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
        intOffset = 1
    Else
        intOffset = 0
    End If

    ' Read the public variable for start position.
    If gFirstTime Then intOffset = 0
    ' Assign a value to the start value.
    intStart = frmMDI.ActiveForm.ActiveControl.SelStart + intOffset

    ' If not case sensitive, convert the string to upper case
    If gFindCase Then
        strFindString = gFindString
        strSourceString = frmMDI.ActiveForm.ActiveControl.Text
    Else
        strFindString = UCase(gFindString)
        strSourceString = UCase(frmMDI.ActiveForm.ActiveControl.Text)
    End If

    ' Search for the string.
    If gFindDirection = 1 Then
        intPos = InStr(intStart + 1, strSourceString, strFindString)
    Else
        For intPos = intStart - 1 To 0 Step -1
            If intPos = 0 Then Exit For
            If Mid(strSourceString, intPos, Len(strFindString)) = strFindString Then Exit For
        Next
    End If

    ' If the string is found...
    If intPos Then
        frmMDI.ActiveForm.ActiveControl.SelStart = intPos - 1
        frmMDI.ActiveForm.ActiveControl.SelLength = Len(strFindString)
    Else
        strMsg = "Cannot find " & Chr(34) & gFindString & Chr(34)
        intResponse = MsgBox(strMsg, 0, App.Title)
    End If

    ' Reset the public variables
    gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
    gFirstTime = False
End Sub

Sub GetRecentFiles()
    ' This procedure demonstrates the use of the GetAllSettings function,
    ' which returns an array of values from the Windows registry. In this
    ' case, the registry contains the files most recently opened.  Use the
    ' SaveSetting statement to write the names of the most recent files.
    ' That statement is used in the WriteRecentFiles procedure.
    Dim i, j As Integer
    Dim varFiles As Variant ' Varible to store the returned array.

    ' Get recent files from the registry using the GetAllSettings statement.
    ' ThisApp and ThisKey are constants defined in this module.
    If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub

    varFiles = GetAllSettings(ThisApp, ThisKey)

    For i = 0 To UBound(varFiles, 1)

        frmMDI.mnuRecentFile(0).Visible = True
        frmMDI.mnuRecentFile(i).Caption = varFiles(i, 1)
        frmMDI.mnuRecentFile(i).Visible = True
            ' Iterate through all the documents and update each menu.
            For j = 1 To UBound(Document)
                If Not FState(j).Deleted Then
                    Document(j).mnuRecentFile(0).Visible = True
                    Document(j).mnuRecentFile(i + 1).Caption = varFiles(i, 1)
                    Document(j).mnuRecentFile(i + 1).Visible = True
                End If
            Next j
    Next i

End Sub

Sub OptionsToolbarProc(CurrentForm As Form)

    ' Toggle the check
        CurrentForm.mnuOptionsToolbar.Checked = Not CurrentForm.mnuOptionsToolbar.Checked
    ' If not the MDI form, set the MDI form's check.
    If Not TypeOf CurrentForm Is MDIForm Then
        frmMDI.mnuOptionsToolbar.Checked = CurrentForm.mnuOptionsToolbar.Checked
    End If
    gToolsHidden = frmMDI.mnuOptionsToolbar.Checked
    ' Toggle the toolbar based on the value.
    If gToolsHidden Then
        frmMDI.picToolbar.Visible = True
    Else
        frmMDI.picToolbar.Visible = False
    End If
End Sub

Sub WriteRecentFiles(OpenFileName)
    ' This procedure uses the SaveSettings statement to write the names of
    ' recently opened files to the System registry. The SaveSetting
    ' statement requires three parameters. Two of the parameters are
    ' stored as constants and are defined in this module.  The GetAllSettings
    ' function is used in the GetRecentFiles procedure to retrieve the
    ' file names stored in this procedure.

    Dim i, j As Integer
    Dim strFile, Key As String

    ' Copy RecentFile1 to RecentFile2, and so on.
    For i = 3 To 1 Step -1
        Key = "RecentFile" & i
        strFile = GetSetting(ThisApp, ThisKey, Key)
        If strFile <> "" Then
            Key = "RecentFile" & (i + 1)
            SaveSetting ThisApp, ThisKey, Key, strFile
        End If
    Next i

    ' Write the open file to first recent file.
    SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
End Sub


Public Sub AnimateAssis()
    Dim frmcount As Integer

    frmcount = frmMDI.Assistant1.FrameCount
    ' Play animation.
    If frmMDI.Assistant1.AssistantVisible And Not frmMDI.Assistant1.IsAnimationPlaying Then
        frmMDI.Assistant1.PlayAnimation 1, frmcount, False
    End If

End Sub